home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d3
/
wastrip.arc
/
WASTRIP.BAS
< prev
Wrap
BASIC Source File
|
1980-01-01
|
3KB
|
59 lines
10 GOTO 70
20 'WASTRIP.BAS -- a program to convert IBM Writing Assistant text files
30 ' into ASCII text files, while displaying results on a color
40 ' monitor, with emphasized characters displayed as emphasized.
50 ' Written by Stewart A. Pollock on November 8, 1985
60 ' Placed in the Public Domain.
70 DEFINT A-Z:COLOR 7,1,1:CLS:SO$=CHR$(14)
80 CR$=CHR$(13):LF$=CHR$(10):SUB$=CHR$(26):SP$=CHR$(32):NUL$=CHR$(0)
90 INPUT "What is the name of the file to strip?",F$
100 IF F$="h" OR F$="H" THEN FILES:GOTO 90 'HELP? -- show the directory
110 INPUT "What is the name of the resulting file?",G$
120 IF G$="h" OR F$="H" THEN FILES:GOTO 110
130 OPEN F$ AS #1 LEN=1:OPEN G$ AS #2 LEN=1
140 FIELD #1, 1 AS A$:FIELD #2, 1 AS B$
150 GET #1, 1024 'jump straight to the text, past W.A. information
200 GET #1 'read a character
210 AC = ASC(A$)
220 IF AC < 32 GOTO 300 'watch for control characters
230 IF AC > 127 THEN GOSUB 510: GOTO 200 'handle emphasized characters
240 LSET B$=A$:PUT #2:PRINT A$; 'write to new text-file and display
250 GOTO 200
300 IF A$=CR$ THEN GOSUB 420:GOTO 200 'check for carriage return
310 IF A$=SO$ THEN LSET B$=SUB$:PUT #2:GOTO 340 'check for end of W. A. text
320 IF A$=NUL$ AND LOC(1)>LOF(1) THEN LSET B$=SUB$:PUT #2:GOTO 340 'check for nulls just in case you missed the end of W. A. file
330 GOTO 200 'ignore all other control characters
340 CLOSE
350 END
400 '**** SUBROUTINES
410 'Routine to insert Carriage Return - Line Feed sequence at end of line
420 LSET B$=CR$:PUT #2:LSET B$=LF$:PUT #2:PRINT :RETURN
430 'routine to handle emphasized strings
440 ' Each emphasized character is followed by a character which defines
450 ' the emphasis for that particular character. There are two sets of
460 ' these "defining" characters: one for letters and one for numerals and
470 ' punctuation. This routine reads the next character, determines
480 ' whether the emphasized character is alpha or numeric, decodes the
490 ' character and then uses ON . . . GOTO to determine and display the
500 ' particular emphasis.
510 GET #1:BV=ASC(A$):IF BV<209 THEN DIF=192:BS=192:ELSE DIF=128:BS=208
520 BS=BV-BS:LSET B$=CHR$(AC-DIF):PUT #2
530 ON BS GOTO 540,550,560,570,580,590,600,610,620,630,640,650,660,670,680
540 COLOR 1,7:PRINT B$;:GOTO 700
550 COLOR 23,1:PRINT B$;:GOTO 700
560 COLOR 17,7:PRINT B$;:GOTO 700
570 COLOR 4,1:PRINT B$;:GOTO 700
580 COLOR 1,4:PRINT B$;:GOTO 700
590 COLOR 20,1:PRINT B$;:GOTO 700
600 COLOR 17,4:PRINT B$;:GOTO 700
610 COLOR 2,1:PRINT B$;:GOTO 700
620 COLOR 1,2:PRINT B$;:GOTO 700
630 COLOR 18,1:PRINT B$;:GOTO 700
640 COLOR 17,2:PRINT B$;:GOTO 700
650 COLOR 3,1:PRINT B$;:GOTO 700
660 COLOR 1,3:PRINT B$;:GOTO 700
670 COLOR 19,1:PRINT B$;:GOTO 700
680 COLOR 17,3:PRINT B$;:GOTO 700
690 COLOR 5,2,1:PRINT B$;:LSET B$=CHR$(ASC(A$)-128):PUT #2:PRINT B$;
700 COLOR 7,1,1:RETURN